MS Excel VBA:Pausing code execution
Original: http://www.cpearson.com/excel/WaitFunctions.aspx, Copyright © 1997 - 2013, Charles H. Pearson, all rights reserved. Reproduced here without authorisation, as basis for future work. ---- Introduction There may be circumstances under which you want to pause code execution for some period of time, such as to allow the user to update a worksheet or an asynchronous task to finish. There are (at least) four ways of doing this. Two of the methods (SetTimer and a tight timer loop) allow other code to execute and events to be raised while the code is waiting. The other two methods (Sleep and Wait) defer events until the timeout period has expired. Pause Using Application.Wait You can use Application.Wait to pause execution until a time is reached. For example, Application.Wait Now + TimeSerial(0, 0, SecondsToWait) Code execution will pause on this line for SecondsToWait seconds. During this period, you are locked out of the application. Any events, such as a command button's Click event or an Application.OnTime event, are deferred until the Wait timer expires. The BREAK key is deferred until the wait expires. You cannot break out of the wait. However, background tasks such as calculation and printing can continue to execute during the Wait period. Pause Using The Sleep API Function Windows provides an API function named Sleep that suspends the current process thread for some number of milliseconds. During this wait period, you are locked out of the application and all events are deferred until the wait is complete. The BREAK key cannot be used to break out of the wait. #If VBA7 And Win64 Then ' 64 bit Excel Public Declare PtrSafe Sub Sleep Lib "kernel32" ( _ ByVal dwMilliseconds As LongLong) #Elsee ' 32 bit Excel Public Declare Sub Sleep Lib "kernel32" ( _ ByVal dwMilliseconds As Long) #End If Sub Test() Sleep NumberOfSeconds * 1000 End Sub Pause Using A Tight Timer Loop You can pause the execution by using a tight timer loop. The code doesn't exactly pause execution. Rather, it just loops for the specified number of seconds. Within the loop, DoEvents is called to allow keyboard and mouse events to occur. During the loop, you are not locked out of the application and events occur normally during the loop. You can use the BREAK key to get break out of the loop. For example, Dim StartTick As Long Dim CurrTick As Long Dim EndTick As Long On Error Goto ErrHandler Application.EnableCancelKey = xlErrorHandler StartTick = GetTickCount EndTick = GetTickCount + (NumberOfSeconds * 1000) Do CurrTick = GetTickCount DoEvents Loop Until CurrTick >= EndTick Exit Sub ErrHandler: ' Break Key Pressed EndTick = 0 This will loop for NumberOfSeconds seconds. Events occur normally during the wait period. The BREAK key can be used to get out of the wait. Pause Using SetTimer And KillTimer Another way to pause execution is to use the Windows SetTimer and KillTimer function. SetTimer instructs Windows to execute a specified procedure every NumberOfSeconds * 1000 milliseconds until KillTimer is called. During this period, the application is free and events occur normally. For example, #If VBA7 And Win64 Then ' 64-bit Office Public Declare PtrSafe Function SetTimer Lib "user32" ( _ ByVal HWnd As LongLong, ByVal nIDEvent As LongLong, _ ByVal uElapse As LongLong, _ ByVal lpTimerFunc As LongLong) As LongLong Public Declare PtrSafe Function KillTimer Lib "user32" ( _ ByVal HWnd As LongLong, _ ByVal nIDEvent As LongLong) As LongLong Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongLong #Else'32-bit Office Public Declare Function SetTimer Lib "user32" ( _ ByVal HWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer Lib "user32" ( _ ByVal HWnd As Long, _ ByVal nIDEvent As Long) As Long Public Declare Function GetTickCount Lib "kernel32" () As Long #End If Sub StartTimer() Dim TimerID As Long TimerID = SetTimer(0&, 0&, NumberOfSeconds * 1000, AddressOf APITimerProc) End Sub #If VBA7 AND WIN64 Then ' 64-bit Office Sub APITimerProc(ByVal HWnd As LongLong, ByVal uMsg As LongLong, _ ByVal nIDEvent As LongLong, ByVal dwTimer As LongLong) ' Callback from Windows when SetTimer timer "pops" KillTimer 0&, nIDEvent End Sub #Else ' 32-bit Office Sub APITimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _ ByVal nIDEvent As Long, ByVal dwTimer As Long) ' Callback from Windows when SetTimer timer "pops" KillTimer 0&, nIDEvent End Sub #End If When the timer "pops", Windows will automatically call APITimerProc, as specified with the AddressOf operator in the call to SetTimer. You must not change the method signature of APITimerProc. You can change the name of the procedure and the names of the parameters, but you must not change the number of and data types of the parameters. If you do, Excel will likely crash. Pause Execution For User Input You can use code to pause execution until the user changes a particular cell. The following code should be placed in the ThisWorkbook code module: Private WatchCell As Range Private CellChanged As Boolean Public Function WaitForUserInput(WaitSeconds As Long, _ WaitCell As Range) As Boolean Dim TimeStart As Double CellChanged = False Set WatchCell = WaitCell TimeStart = Now Do DoEvents If CellChanged = True Then WaitForUserInput = True Exit Function End If Loop While Now - TimeStart < TimeSerial(0, 0, WaitSeconds) WaitForUserInput = False End Function Private Sub Workbook_SheetChange(ByVal Sh As Object, _ ByVal Target As Range) If Not WatchCell Is Nothing Then If Not Application.Intersect(Target, WatchCell) Is Nothing Then CellChanged = True End If End If End Sub To pause execution until user input, call WaitForUserInput passing to it the number of seconds to wait before expiring and the the cell(s) reference to test for changes. The function will return True if the user changes the cell(s) before the wait expires. It will return False is the user does not change the cell(s) within the wait time. For example, Sub Test() Dim B As Boolean B = ThisWorkbook.WaitForUserInput(WaitSeconds:=10, _ WaitCell:=Worksheets(1).Range("A1")) If B = True Then Debug.Print "cell changed" Else Debug.Print "cell not changed" End If End Sub This code will wait for 10 seconds for the user to modify cell A1. Pausing code execution